perm filename COREL.SAI[CRE,BGB] blob
sn#072759 filedate 1973-11-18 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 BEGIN "COREL"
00005 00003 α MAIL DEFINITIONS
00006 00004 α ARGUMENT FETCH
00008 00005 α MAKE SUB WINDOW BYTE POINTERS
00009 00006 BEGIN "BUFFER BLK"
00010 00007 START_CODE "GET SUBWINDOWS"
00011 00008 α ACCUMULATE SUMMATION X AND SUMMATION X SQUARED
00012 00009 α INIT Y SQUARED TABLE
00013 00010 α INIT BEST ANSWER VARIABLE
00014 00011 START_CODE "CROSS MULTIPLY"
00016 00012 α COMPUTE VARIANCE AND COVARIANCE
00017 00013 α MOVE THE WINDOW DOWN A ROW IN THE Y ARRAY
00019 00014 α MOVE THE WINDOW RIGHT A COLUMN IN THE Y ARRAY
00021 00015 α FIND THE AVERAGE AND MAXIMUM RADIUS OF THE POINTS ABOVE THRESHOLD,
00023 00016 α CREATE RESULT SEGMENT WHEN CALLED FOR
00024 ENDMK
⊗;
BEGIN "COREL"
REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
REQUIRE "TRIGER[SYS,BGB]" SOURCE_FILE;
SAFE INTEGER ARRAY MULT[0:'7777];
α DATA DIMENSIONS;
INTEGER R1,C1,R2,C2,PTR1,PTR2;
INTEGER N1,M1,N2,M2,DN,DM,SIZ1,SIZ2,SIZ3,N2M1;
α SUMMATIONS;
INTEGER MX,MXX,MY,MYY,MY1,MYY1,MXY;
α VARIANCE, STANDARD DEVIATION, AND RESULTS;
REAL VX,VY,SDX,SDY,COVAR,RMAX;
REAL THRESHOLD,RADIUS,MAXRAD,AVGRAD;
INTEGER NCNT;
INTEGER II,JJ;
α LOOP INDICES;
INTEGER I,J,K;
INTEGER TIME1,TIME2;
INTEGER FLG,FLG1,FLG2,FLG3;
STRING STR,PROBE;
α UPPER SEGMENT DEFINITIONS;
DEFINE CALLI = "'047000000000";
DEFINE CORE2 = "'400015";
DEFINE ATTSEG = "'400016";
DEFINE DETSEG = "'400017";
DEFINE SEGSIZ = "'400022";
DEFINE SETNM2 = "'400036";
DEFINE NAMEIN = "'400043";
DEFINE _PROBE = "'126062574245";
DEFINE _TARGT = "'126441624764";
DEFINE _RSULT = "'126263655464";
DEFINE SAISG2 = "'634151634722";
DEFINE HALT = "JRST 4,";
α MAIL DEFINITIONS;
INTEGER CALLER,LTRPTR;
SAFE INTEGER ARRAY LETTER[0:31];
DEFINE MAIL = "'710000000000";
α INIT MULTIPLICATION TABLE;
FOR I←0 STEP 1 UNTIL 63 DO
FOR J←0 STEP 1 UNTIL 63 DO
MULT[(I LSH 6)LOR J]←I*J;
LTRPTR ← BBPP(36,LETTER[0],35);
CALLER ← 0;
OUTCHR("*");
α COMMAND MAIL LISTEN LOOP;
WHILE TRUE DO
BEGIN "FOREVER"
LABEL EOL;
START_CODE "MAIL"
LABEL L1,L2;
α SEND RESULTS TO THE CALLER, (IF HE EXISTS);
SKIPN CALLER;
JRST L1;
MAIL CALLER;
JRST EOL;
α WAIT FOR A COMMAND LETTER;
L1: MOVE LETTER;
HRRM L2;
L2: MAIL 1,;
END "MAIL";
α ARGUMENT FETCH;
BEGIN "ARGUMENTS"
CALLER ← LETTER[0];
FLG1 ← LETTER[1];
FLG2 ← LETTER[2];
FLG3 ← LETTER[3];
R1 ← LETTER[4]; R2 ← LETTER[8];
C1 ← LETTER[5]; C2 ← LETTER[9];
M1 ← LETTER[6]; M2 ← LETTER[10];
N1 ← LETTER[7]; N2 ← LETTER[11];
START_CODE
MOVE 11,LETTER;
MOVE 11,12(11);
MOVEM 11,THRESHOLD;
SETZM NCNT;
END;
II←JJ←RMAX←-1;
α KILL UPPER SEGMENTS AND RETURN;
IF FLG3 THEN
START_CODE
SETZ 1,;
CALLI DETSEG;
MOVE [_PROBE];
CALLI ATTSEG; JFCL;
CALLI 1, CORE2; JFCL;
MOVE [_TARGT];
CALLI ATTSEG; JFCL;
CALLI 1, CORE2; JFCL;
MOVE [_RSULT];
CALLI ATTSEG; JFCL;
CALLI 1, CORE2; JFCL;
MOVE [SAISG2];
CALLI ATTSEG; JFCL;
JRST EOL;
END;
SIZ1 ← M1*N1;
SIZ2 ← M2*N2;
N2M1 ← N2*M1;
DN ← N2 - N1;
DM ← M2 - M1;
SIZ3 ← (DN+1)*(DM+1);
IF DN≤0 ∨ DM≤0 THEN GO EOL;
END "ARGUMENTS";
α MAKE SUB WINDOW BYTE POINTERS;
α WRD ← R*48 + C%6 + '400001;
α BRI ← 36 - (C MOD 6)*6;
START_CODE
MOVE 0, C1;
IDIVI 0, 6;
IMULI 1, 6;
MOVEI 2, 36;
SUB 2, 1;
ANDI 2, '77;
ROT 2, -6;
TLO 2, '600;
MOVE 1, R1;
IMULI 1, 48;
ADDI 1, '400001;
ADD 1, 0;
HRR 2, 1;
MOVEM 2, PTR1;
END;
START_CODE
MOVE 0, C2;
IDIVI 0, 6;
IMULI 1, 6;
MOVEI 2, 36;
SUB 2, 1;
ANDI 2, '77;
ROT 2, -6;
TLO 2, '600;
MOVE 1, R2;
IMULI 1, 48;
ADDI 1, '400001;
ADD 1, 0;
HRR 2, 1;
MOVEM 2, PTR2;
END;
BEGIN "BUFFER BLK"
INTEGER ARRAY X[1:SIZ1];
INTEGER ARRAY Y[1:SIZ2];
REAL ARRAY R[0:DM,0:DN];
α UNPACK A SUB WINDOW FROM THE UPPER SEGMENT;
PROCEDURE UNPACKER;
START_CODE
DEFINE PTR = "1";
DEFINE MCNT = "2";
DEFINE N = "3";
DEFINE NCNT = "4";
DEFINE OUTPTR = "5";
DEFINE INPTR = "6";
LABEL L1,L2;
MOVE OUTPTR, 0;
L1: MOVE NCNT, N;
MOVE INPTR, PTR;
L2: ILDB INPTR;
MOVEM (OUTPTR);
AOS OUTPTR;
SOJG NCNT, L2;
ADDI PTR, 48;
SOJG MCNT, L1;
END;
START_CODE "GET SUBWINDOWS"
LABEL L;
CALLI 1, DETSEG;
α PROBE WINDOW;
MOVE [_PROBE];
CALLI ATTSEG;
JRST EOL;
MOVE 0, X;
MOVE 1, PTR1;
MOVE 2, M1;
MOVE 3, N1;
PUSHJ 15, UNPACKER;
SKIPN FLG1; α AUTO/CROSS FLAG;
JRST L;
CALLI 1, DETSEG;
α TAGET WINDOW;
MOVE [_TARGT];
CALLI ATTSEG;
JRST EOL;
L: MOVE 0, Y;
MOVE 1, PTR2;
MOVE 2, M2;
MOVE 3, N2;
PUSHJ 15, UNPACKER;
CALLI 1, DETSEG;
α RETURN TO SAIL;
MOVE [SAISG2];
CALLI ATTSEG;
JRST EOL;
END "GET SUBWINDOWS";
α ACCUMULATE SUMMATION X AND SUMMATION X SQUARED;
MXX ← MX ← 0;
FOR K←1 STEP 1 UNTIL SIZ1 DO
BEGIN
MX ← MX + X[K];
MXX ← MXX + X[K]↑2;
X[K] ← X[K] LSH 6;
END;
VX ← MXX/SIZ1 - (MX/SIZ1)↑2;
SDX ← SQRT(VX);
α ACCUMULATE SUMMATION Y AND SUMMATION Y SQUARED;
MY ← MYY ← 0;
FOR I←0 STEP N2 UNTIL (M1-1)*N2 DO
FOR J←1 STEP 1 UNTIL N1 DO
BEGIN
MY ← MY + Y[I+J];
MYY ← MYY+ Y[I+J]↑2;
END;
MY1 ← MY;
MYY1 ← MYY;
α INIT Y SQUARED TABLE;
START_CODE
LABEL L1,L2;
MOVE 13,SIZ2;
MOVE 12,Y;
SOS 12;
HRRM 12,L1;
HRRM 12,L2;
L1: MOVE 11,(13);
IMUL 11,11;
L2: HRLM 11,(13);
SOJG 13,L1;
END;
α INIT BEST ANSWER VARIABLE;
RMAX ← -10;
α START THE CLOCKS;
TIME1 ← CALL(0,"RUNTIM");
TIME2 ← CALL(0,"MSTIME");
α MOVE THE SMALLER WINDOW THROUGH ALL POSSIBLE POSITIONS IN THE BIGGER ONE;
FOR J←0 STEP 1 UNTIL DN DO
BEGIN "COLUMN OFFSET"
FOR I←0 STEP 1 UNTIL DM DO
BEGIN "ROW OFFSET"
START_CODE "CROSS MULTIPLY"
LABEL L0,EXIT;
α NAME AFEW ACCUMULATORS;
DEFINE SUM="0", XY="1", R ="2", C ="3",
L1 ="4", L2 ="5", YPTR="6", XPTR="7";
α LOAD THE CACHE;
HRLI L0; α FROM HERE;
HRRI L1; α TO THERE;
BLT 13; α TO LAST;
α INITIALIZATION OF INNER LOOP;
HRR 4,N1; α COLUMN COUNT;
HRR 11,DN; α YPTR INCREMENT;
MOVE I;
IMUL N2;
ADD J;
ADD Y;
HRR YPTR,; α INIT YPTR;
HRR XPTR,X;
SOS XPTR; α INITIAL XPTR ADDRESS;
HRR 8,MULT;
MOVE R,M1; α INITIAL ROW COUNT;
SETZ SUM,;
JRST L1; α ENTER THE LOOP;
α INNER LOOP ACCUMULATOR CODE;
L0: MOVEI C,N1; α ADDRESS MODIFIED BY INITIALIZATION;
AOS XPTR;
HRRZ XY, ; α ADDRESS MODIFIED BY INIT AND THE LOOP;
IOR XY, ; α ADDRESS MODIFIED BY INIT AND THE LOOP;
ADD MULT(XY); α MULTIPLICATION BY TABLE LOOKUP;
AOS YPTR;
SOJG C,L2; α DECREMENT COLUMN COUNTER;
ADDI YPTR,DN; α ADDRESS MODIFIED BY INITIALIZATION;
SOJG R,L1; α DECREMENT ROW COUNTER;
JRST EXIT; α END OF INNER LOOP;
α EXIT THE INNER LOOP;
EXIT: MOVEM SUM,MXY;
END "CROSS MULTIPLY";
α COMPUTE VARIANCE AND COVARIANCE;
VY ← (MYY/SIZ1) - (MY/SIZ1)↑2;
COVAR ← (MXY/SIZ1) - (MX/SIZ1)*(MY/SIZ1);
SDY ← SQRT(VY);
R[I,J] ← COVAR/(SDX*SDY);
IF R[I,J]>RMAX THEN
RMAX ← R[II←I,JJ←J];
IF R[I,J]>THRESHOLD THEN NCNT←NCNT+1;
α MOVE THE WINDOW DOWN A ROW IN THE Y ARRAY;
START_CODE "DOWN A ROW"
DEFINE PTR="1",YAC="2",YYAC="3";
LABEL L1,EXIT,Q;
α LOAD THE CACHE;
HRLI L1; α FROM;
HRRI 4; α TO;
BLT 13; α LAST;
α INITIALIZATION;
MOVE I; α ROW OFFSET;
IMUL N2;
ADD J; α COL OFFSET;
ADD Y;
Q: SOS;
HRR 4,; α Y OLD PTR;
HRR 6,;
ADD N2M1;
HRR 8,; α Y NEW PTR;
HRR 10,;
MOVE PTR,N1; α COLUMN COUNT;
SETZB YAC,YYAC;
JRST 4;
α INNER LOOP;
L1:
HRRZ (PTR); α OLD ROW;
SUB YAC,;
HLRZ (PTR); α OLD ROW;
SUB YYAC,;
HRRZ (PTR); α NEW ROW;
ADD YAC,;
HLRZ (PTR); α NEW ROW;
ADD YYAC,;
SOJG PTR,4;
JRST EXIT;
EXIT: ADDM YAC,MY; α UPDATE THE SUMMATIONS;
ADDM YYAC,MYY;
END "DOWN A ROW";
END "ROW OFFSET";
α MOVE THE WINDOW RIGHT A COLUMN IN THE Y ARRAY;
START_CODE "RIGHT A COLUMN"
INTEGER TMP;
DEFINE PTR="1",YAC="2",YYAC="3";
LABEL L1,EXIT;
MOVEM 14,TMP;
α LOAD THE CACHE;
HRLI L1; α FROM;
HRRI 4; α TO;
BLT 14; α LAST;
α INITIALIZATION;
MOVE Y; α THAT IS Y[1];
SUB N2;
ADD J; α COL OFFSET;
HRR 4,; α Y OLD PTR;
HRR 6,;
ADD N1;
HRR 8,; α Y NEW PTR;
HRR 10,;
MOVE PTR,N2M1; α ROW COUNT IN UNITS OF M2;
SETZB YAC,YYAC;
HRR 12,N2;
JRST 4;
α INNER LOOP;
L1:
HRRZ (PTR); α OLD COLUMN;
SUB YAC,;
HLRZ (PTR); α OLD COLUMN;
SUB YYAC,;
HRRZ (PTR); α NEW COLUMN;
ADD YAC,;
HLRZ (PTR); α NEW COLUMN;
ADD YYAC,;
SUBI PTR, ;
JUMPG PTR,4;
JRST EXIT;
EXIT: ADDB YAC,MY1; α UPDATE MY1 & MYY1;
ADDB YYAC,MYY1;
MOVEM YAC,MY; α RESET MY & MYY;
MOVEM YYAC,MYY;
MOVE 14,TMP;
END "RIGHT A COLUMN";
END "COLUMN OFFSET";
α FIND THE AVERAGE AND MAXIMUM RADIUS OF THE POINTS ABOVE THRESHOLD,
α ABOUT THE RMAX POINT;
MAXRAD←AVGRAD←0;
FOR I←0 STEP 1 UNTIL DM DO
FOR J←0 STEP 1 UNTIL DN DO
IF R[I,J]≥THRESHOLD THEN
BEGIN
RADIUS ← SQRT( (II-I)↑2 + (JJ-J)↑2 );
MAXRAD ← MAXRAD MAX RADIUS;
AVGRAD ← AVGRAD + RADIUS;
END;
AVGRAD ← AVGRAD/NCNT;
TIME1 ← CALL(0,"RUNTIM") - TIME1;
TIME2 ← CALL(0,"MSTIME") - TIME2;
α PLACE RESULTS IN THE LETTER;
LETTER[13] ← II;
LETTER[14] ← JJ;
LETTER[16] ← NCNT;
LETTER[19] ← TIME1;
LETTER[20] ← TIME2;
START_CODE
MOVE 1, LETTER;
MOVE RMAX;
MOVEM 15(1);
MOVE MAXRAD;
MOVEM 17(1);
MOVE AVGRAD;
MOVEM 18(1);
END;
α CREATE RESULT SEGMENT WHEN CALLED FOR;
IF FLG2 THEN
START_CODE "RESULTS"
SETZ 1,;
CALLI DETSEG;
MOVE [_RSULT];
CALLI ATTSEG; SKIPA;
SKIPA;
CALLI 1,CORE2; JFCL;
MOVE 1,SIZ3;
CALLI 1,CORE2; JFCL;
HRLZ R;
HRRI '400001;
BLT '400001(1);
MOVE [_RSULT];
CALLI SETNM2; JFCL;
CALLI 1,DETSEG;
MOVE [SAISG2];
CALLI ATTSEG; JFCL;
END "RESULTS";
END "BUFFER BLK";
EOL:
END "FOREVER";
END "COREL";